home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / Clinic / AutoRptBtnsU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-01-26  |  2.9 KB  |  109 lines
  1. unit AutoRptBtnsU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, ComCtrls, ToolWin, StdCtrls, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ToolBar1: TToolBar;
  12.     ToolButton1: TToolButton;
  13.     Timer1: TTimer;
  14.     Button1: TButton;
  15.     SpeedButton1: TSpeedButton;
  16.     procedure AutoRepeatMouseDown(Sender: TObject; Button: TMouseButton;
  17.       Shift: TShiftState; X, Y: Integer);
  18.     procedure AutoRepeatMouseUp(Sender: TObject; Button: TMouseButton;
  19.       Shift: TShiftState; X, Y: Integer);
  20.     procedure AutoRepeatMouseMove(Sender: TObject; Shift: TShiftState; X,
  21.       Y: Integer);
  22.     procedure Timer1Timer(Sender: TObject);
  23.     procedure ToolButton1Click(Sender: TObject);
  24.     procedure Button1Click(Sender: TObject);
  25.     procedure SpeedButton1Click(Sender: TObject);
  26.   private
  27.     Ctrl: TControl;
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.DFM}
  36.  
  37. const
  38.   InitRepeatPause = 400;  { pause before repeat timer starts (ms) }
  39.   RepeatPause     = 200;  { pause before successive hits (ms)}
  40.  
  41. type
  42.   //Access class needed to get at Click method,
  43.   //which is protected in the TControl base class.
  44.   //TControl is used so this code will work against
  45.   //any visual control with an OnClick event handler
  46.   TControlAccess = class(TControl);
  47.  
  48. procedure TForm1.AutoRepeatMouseDown(Sender: TObject;
  49.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  50. begin
  51.   Ctrl := Sender as TControl;
  52.   Timer1.Interval := InitRepeatPause;
  53.   Timer1.Enabled := True;
  54.   //Don't let the normal click happen when mouse is released,
  55.   //just the faked clicks from the timer will suffice
  56.   Ctrl.ControlState := Ctrl.ControlState - [csClicked];
  57. end;
  58.  
  59. procedure TForm1.AutoRepeatMouseUp(Sender: TObject; Button: TMouseButton;
  60.   Shift: TShiftState; X, Y: Integer);
  61. begin
  62.   //If timer didn't tick at all, do one click
  63.   if Timer1.Enabled and (Timer1.Interval = InitRepeatPause) then
  64.     TControlAccess(Ctrl).Click;
  65.   Timer1.Enabled := False;
  66.   Ctrl := nil;
  67. end;
  68.  
  69. procedure TForm1.AutoRepeatMouseMove(Sender: TObject; Shift: TShiftState;
  70.   X, Y: Integer);
  71. begin
  72.   if Assigned(Ctrl) and (csLButtonDown in Ctrl.ControlState) then
  73.     with Ctrl do
  74.       Timer1.Enabled := PtInRect(Rect(0, 0, Width, Height), Point(X, Y))
  75. end;
  76.  
  77. procedure TForm1.Timer1Timer(Sender: TObject);
  78. begin
  79.   Timer1.Interval := RepeatPause;
  80.   try
  81.     TControlAccess(Ctrl).Click;
  82.     //If button has been disabled as a result of what
  83.     //happens in its OnClick method, shutdown timer
  84.     Timer1.Enabled := Ctrl.Enabled;
  85.   except
  86.     Timer1.Enabled := False;
  87.     raise;
  88.   end;
  89. end;
  90.  
  91. procedure TForm1.ToolButton1Click(Sender: TObject);
  92. begin
  93.   Beep
  94. end;
  95.  
  96. procedure TForm1.Button1Click(Sender: TObject);
  97. begin
  98.   Color := Random($1000000);
  99. end;
  100.  
  101. procedure TForm1.SpeedButton1Click(Sender: TObject);
  102. begin
  103.   Caption := TimeToStr(Time)
  104. end;
  105.  
  106. initialization
  107.   Randomize
  108. end.
  109.